/*
 * Copyright (C) 2008,2009,2010,2011  Paulo Cesar Pereira de Andrade.
 *
 * This is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * Authors:
 *	Paulo Cesar Pereira de Andrade
 */

#include "exl.h"

/*
 * Prototypes
 */
static esymbol_t *
setup_symbol(esymbol_t *name, char *kind);

static eint32_t
setup_single_vector(eobject_t list, eobject_t length);

static eint32_t
setup_vector(eobject_t list, eobject_t *values, eint32_t length);

static void
setup_struct(eobject_t list, erecord_t **record_r, esymbol_t **symbol_r);

static esymbol_t *
class_field(esymbol_t *name);

static etag_t *
setup_pointer(eobject_t pointer);

static eint32_t
setup_vararg(eobject_t list);

static void
setup_hash(eobject_t list);

static void
initialize(eobject_t pointer, eobject_t object,
	   eint32_t offset, etype_t r_type, etype_t f_type,
	   erecord_t *record, esymbol_t *symbol);

static void
vector_allocate(eobject_t pointer, eobject_t list,
		eobject_t *values, eint32_t dimensions,
		eint32_t offset, etype_t type, eint32_t length);

static void
vector_initialize(eobject_t pointer, eobject_t list,
		  eobject_t *values, eint32_t dimensions,
		  eint32_t offset, etype_t type);

static void
struct_initialize(eint8_t *object, eobject_t list, erecord_t *record);

static eobject_t
data_vector(eobject_t list);

static eobject_t
data_record(eobject_t list);

static eobject_t
data_union(eobject_t list);

static eobject_t
data_object(eobject_t list);

static eint32_t
vector_format(eobject_t list);

static void
struct_format(erecord_t *record, eobject_t list);

static void
object_format(eint32_t offset, eint32_t before, eobject_t base,
	      eobject_t *list_r, eobject_t *prev_r);

/*
 * Initialization
 */
etag_t *data_tag;

/*
 * Implementation
 */
etag_t *
edata(eobject_t list)
{
    if (data_tag == null)
	eparse_error(null, "no type information");
    switch (data_tag->type) {
	case tag_vector:
	    data_vector(list);
	    break;
	case tag_class:
	case tag_struct:
	    data_record(list);
	    break;
	case tag_union:
	    data_union(list);
	    break;
	default:
	    eparse_error(null, "syntax error");
    }
    return (data_tag);
}

etag_t *
esymbol_load(esymbol_t *name)
{
    esymbol_t	*atom;
    atom = setup_symbol(name, "rvalue");
    if (!atom->a_global && atom->a_field)
	return (eclass_load(atom));
    east_link(ecode_symbol_load(atom));
    return (atom->tag);
}

etag_t *
esymbol_store(esymbol_t *name, eobject_t value)
{
    etag_t	*tag;
    esymbol_t	*atom;
    atom = setup_symbol(name, "lvalue");
    if (!atom->a_global && atom->a_field)
	return (eclass_store(atom, value));
    tag = eeval(value);
    east_link(ecode_symbol_store(atom));
    return (tag);
}

etag_t *
esymbol_setop(esymbol_t *name, eobject_t value, ecode_t code)
{
    esymbol_t		*atom;
    atom = setup_symbol(name, "lvalue");
    if (!atom->a_global && atom->a_field)
	return (eclass_setop(atom, value, code));
    east_link(ecode_symbol_load(atom));
    east_link(ecode_push_binarg());
    (void)eeval(value);
    east_logic_link(ecode_binary(code));
    east_link(ecode_symbol_store(atom));
    return (atom->tag);
}

etag_t *
esymbol_incdec(esymbol_t *name, ebool_t post, ecode_t code)
{
    esymbol_t	*atom;
    atom = setup_symbol(name, "lvalue");
    if (!atom->a_global && atom->a_field)
	return (eclass_incdec(atom, post, code));
    east_link(ecode_symbol_load(atom));
    if (post)
	east_link(ecode_push_incdec());
    east_link(ecode_simple(code));
    east_link(ecode_symbol_store(atom));
    if (post)
	east_link(ecode_stack_pop());
    return (atom->tag);
}

etag_t *
esymbol_address(esymbol_t *name)
{
    esymbol_t	*atom;
    atom = eget_bound_symbol(name);
    if (atom->a_function || atom->a_builtin) {
	eint32_t	 flags;
	efunction_t	*lambda;
	/* if function only declared so far */
	if (atom->offset < 0)
	    ereference_function(atom);
	lambda = atom->value;
	flags = 0;
	if (atom->tag != void_tag)
	    flags |= L_result;
	if (atom->a_builtin)
	    flags |= L_builtin;
	if (lambda->voffset)
	    flags |= L_varargs;
	east_link(ecode_function(atom, lambda->args, flags));
	/* FIXME this should be lambda->tag, that is a "subtype"
	 * of function_tag: object (*)(...), and that assuming
	 * ellipsis will be handled as a va_list (no need to an argument) */
	return (function_tag);
    }
    if (atom->a_global) {
	/* if symbol only declared so far */
	if (atom->offset < 0)
	    eglobal_variable(atom->tag, atom);
    }
    else {
	if (atom->a_field)
	    return (eclass_address(atom));
	if (atom->a_method)
	    /* FIXME some way to use class method pointers? */
	    eparse_error(null, "not a rvalue");
    }
    east_link(ecode_symbol_pointer(atom));
    return (etag_pointer(atom->tag));
}

etag_t *
evector_load(eobject_t list)
{
    etag_t	*tag;
    eint32_t	 rank;
    eobject_t	 object;
    eobject_t	*values;
    eint32_t	 length;
    eint32_t	 offset;

    object = ecar(list);
    list = ecdr(list);
    if (object == ellipsis_obj)
	return (evararg_load(list));
    tag = eeval(object);
    if (tag == null || tag->type != tag_vector) {
	if (tag->type == tag_hashtable)
	    return (ehash_load(list));
	eparse_error(null, "not a vector");
    }
    values = tag->data;
    length = (eobject_length(values) / sizeof(eobject_t)) - 1;
    tag = *(etag_t **)tag->data;
    ++values;
    /* check for fast path and valid usage of constant offset */
    if (length == 1) {
	if ((offset = setup_single_vector(list, values[0])) >= 0) {
	    east_link(ecode_vector_load_static(offset));
	    goto done;
	}
	rank = 1;
	goto load;
    }
    rank = setup_vector(list, values, length);
load:
    east_link(ecode_vector_load(rank));
done:
    return (tag);
}

etag_t *
evector_store(eobject_t list, eobject_t value)
{
    etag_t	*tag;
    etag_t	*etag;
    eint32_t	 rank;
    eobject_t	 object;
    eobject_t	*values;
    eint32_t	 length;
    eint32_t	 offset;

    object = ecar(list);
    list = ecdr(list);
    if (object == ellipsis_obj)
	return (evararg_store(list, value));
    tag = eeval(object);
    if (tag == null || tag->type != tag_vector) {
	if (tag->type == tag_hashtable)
	    return (ehash_store(list, value));
	eparse_error(null, "not a vector");
    }
    values = tag->data;
    length = (eobject_length(values) / sizeof(eobject_t)) - 1;
    tag = *(etag_t **)tag->data;
    ++values;
    /* check for fast path and valid usage of constant offset */
    if (length == 1) {
	if ((offset = setup_single_vector(list, values[0])) >= 0) {
	    /* push vector */
	    east_link(ecode_push());
	    etag = eeval(value);
	    east_link(ecode_vector_store_static(offset));
	    goto done;
	}
	rank = 1;
	goto store;
    }
    rank = setup_vector(list, values, length);
store:
    east_link(ecode_vector_offset(rank));
    etag = eeval(value);
    east_link(ecode_vector_store(rank));
done:
    return (tag && etag_packed_p(tag) ? tag : etag);
}

etag_t *
evector_setop(eobject_t list, eobject_t value, ecode_t code)
{
    etag_t		*tag;
    eint32_t		 arg;
    eint32_t		 rank;
    eobject_t		 object;
    eobject_t		*values;
    eint32_t		 length;

    object = ecar(list);
    list = ecdr(list);
    if (object == ellipsis_obj)
	return (evararg_setop(list, value, code));
    tag = eeval(object);
    if (tag == null || tag->type != tag_vector) {
	if (tag->type == tag_hashtable)
	    return (ehash_setop(list, value, code));
	eparse_error(null, "not a vector");
    }
    values = tag->data;
    length = (eobject_length(values) / sizeof(eobject_t)) - 1;
    tag = *(etag_t **)tag->data;
    ++values;
    /* no check for fast path as there isn't an opcode for constant argument */
    rank = setup_vector(list, values, length);
    arg = 2;
    east_link(ecode_vector_load_ref(rank, arg));
    (void)eeval(value);
    east_logic_link(ecode_binary(code));
    arg = 0;
    east_link(ecode_vector_store_ref(arg));
    return (tag);
}

etag_t *
evector_incdec(eobject_t list, ebool_t post, ecode_t code)
{
    etag_t	*tag;
    eint32_t	 arg;
    eint32_t	 rank;
    eobject_t	 object;
    eobject_t	*values;
    eint32_t	 length;

    object = ecar(list);
    list = ecdr(list);
    if (object == ellipsis_obj)
	return (evararg_incdec(list, post, code));
    tag = eeval(object);
    if (tag == null || tag->type != tag_vector) {
	if (tag->type == tag_hashtable)
	    return (ehash_incdec(list, post, code));
	eparse_error(null, "not a vector");
    }
    values = tag->data;
    length = (eobject_length(values) / sizeof(eobject_t)) - 1;
    tag = *(etag_t **)tag->data;
    ++values;
    /* no check for fast path as there isn't an opcode for constant argument */
    rank = setup_vector(list, values, length);
    arg = post ? 1 : 0;
    east_link(ecode_vector_load_ref(rank, arg));
    east_link(ecode_simple(code));
    east_link(ecode_vector_store_ref(arg));
    return (tag);
}

etag_t *
evector_address(eobject_t list)
{
    etag_t	*tag;
    eint32_t	 rank;
    eobject_t	 object;
    eobject_t	*values;
    eint32_t	 length;
    eint32_t	 offset;

    object = ecar(list);
    list = ecdr(list);
    if (object == ellipsis_obj)
	return (evararg_address(list));
    tag = eeval(object);
    if (tag == null || tag->type != tag_vector) {
	if (tag->type == tag_hashtable)
	    /* FIXME operation for hash value pointer */
	    eparse_error(null, "not a rvalue");
	eparse_error(null, "not a vector");
    }
    values = tag->data;
    length = (eobject_length(values) / sizeof(eobject_t)) - 1;
    tag = *(etag_t **)tag->data;
    ++values;
    /* check for fast path and valid usage of constant offset */
    if (length == 1) {
	if ((offset = setup_single_vector(list, values[0])) >= 0) {
	    east_link(ecode_vector_pointer_static(offset));
	    goto done;
	}
	rank = 1;
	goto pointer;
    }
    rank = setup_vector(list, values, length);
pointer:
    east_link(ecode_vector_pointer(rank));
done:
    return (etag_pointer(tag));
}

etag_t *
estruct_load(eobject_t list)
{
    erecord_t		*record;
    esymbol_t		*symbol;
    setup_struct(list, &record, &symbol);
    east_link(ecode_record_load(record, symbol));
    return (symbol->tag);
}

etag_t *
estruct_store(eobject_t list, eobject_t value)
{
    etag_t		*tag;
    erecord_t		*record;
    esymbol_t		*symbol;
    setup_struct(list, &record, &symbol);
    east_link(ecode_push());
    tag = eeval(value);
    east_link(ecode_record_store(record, symbol));
    return (tag);
}

etag_t *
estruct_setop(eobject_t list, eobject_t value, ecode_t code)
{
    eint32_t		 arg;
    erecord_t		*record;
    esymbol_t		*symbol;
    setup_struct(list, &record, &symbol);
    arg = 2;
    east_link(ecode_record_load_ref(record, symbol, arg));
    (void)eeval(value);
    east_logic_link(ecode_binary(code));
    arg = 0;
    east_link(ecode_record_store_ref(arg));
    return (symbol->tag);
}

etag_t *
estruct_incdec(eobject_t list, ebool_t post, ecode_t code)
{
    eint32_t		 arg;
    erecord_t		*record;
    esymbol_t		*symbol;
    setup_struct(list, &record, &symbol);
    arg = post ? 1 : 0;
    east_link(ecode_record_load_ref(record, symbol, arg));
    east_link(ecode_simple(code));
    east_link(ecode_record_store_ref(arg));
    return (symbol->tag);
}

etag_t *
estruct_address(eobject_t list)
{
    erecord_t		*record;
    esymbol_t		*symbol;
    setup_struct(list, &record, &symbol);
    east_link(ecode_record_pointer(record, symbol));
    return (etag_pointer(symbol->tag));
}

etag_t *
eclass_load(esymbol_t *name)
{
    esymbol_t	*atom;

    atom = class_field(name);
    east_link(ecode_class_load(atom));
    return (atom->tag);
}

etag_t *
eclass_store(esymbol_t *name, eobject_t value)
{
    etag_t	*tag;
    esymbol_t	*atom;

    atom = class_field(name);
    tag = eeval(value);
    east_link(ecode_class_store(atom));
    return (atom->tag && etag_packed_p(atom->tag) ? atom->tag : tag);
}

etag_t *
eclass_setop(esymbol_t *name, eobject_t value, ecode_t code)
{
    esymbol_t		*atom;

    atom = class_field(name);
    east_link(ecode_class_load(atom));
    east_link(ecode_push_binarg());
    (void)eeval(value);
    east_logic_link(ecode_binary(code));
    east_link(ecode_class_store(atom));

    return (atom->tag);
}

etag_t *
eclass_incdec(esymbol_t *name, ebool_t post, ecode_t code)
{
    esymbol_t	*atom;

    atom = class_field(name);
    east_link(ecode_class_load(atom));
    if (post)
	east_link(ecode_push_incdec());
    east_link(ecode_simple(code));
    east_link(ecode_class_store(atom));
    if (post)
	east_link(ecode_stack_pop());

    return (atom->tag);
}

etag_t *
eclass_address(esymbol_t *name)
{
    esymbol_t	*symbol;
    symbol = class_field(name);
    /* load 'this' pointer */
    east_link(ecode_symbol_load(eget_symbol(fn_current->hash,
					    symbol_this->name)));
    /* use generic record pr opcode */
    east_link(ecode_record_pointer(fn_current->record, symbol));
    return (etag_pointer(symbol->tag));
}

etag_t *
eaddress_load(eobject_t list)
{
    etag_t	*tag;
    eobject_t	 cons;
    erecord_t	*record;

    cons = ecar(list);
    if (esymbol_p(cons))
	return (esymbol_address(cons));
    if (econs_p(cons) && ecar(cons) == efixnum(tok_new)) {
	/* FIXME not much easy syntax to create anonymous
	 * pointers... but also, not much use of this. */
	cons = ecadr(cons);
	switch (etype(cons)) {
	    case t_void:
		/* &new(auto) */
		tag = null;
		east_link(ecode_record_new_anon(record_vector[t_void]));
		break;
	    case t_tag:
		tag = cons;
		switch (tag->type) {
		    case tag_union:
			tag = null;
			east_link(ecode_record_new_anon(record_vector[t_void]));
			break;
		    case tag_basic:
			record = tag->data;
			switch (record->type) {
			    case t_int8:	case t_uint8:
			    case t_int16:	case t_uint16:
			    case t_int32:	case t_uint32:
			    case t_int64:	case t_uint64:
				record = record_vector[t_int];
				east_link(ecode_record_new_anon(record));
				break;
			    case t_float32:	case t_float64:
				record = record_vector[t_float];
				east_link(ecode_record_new_anon(record));
				break;
			    default:
				/* should have failed earlier */
				eparse_error(null, "not a rvalue");
			}
			break;
		    default:
			tag = eeval(list);
			east_link(ecode_simple(eop_pp));
			break;
		}
		break;
	    default:
		/* should have failed earlier (some valid expressions, but
		 * probably with extra parenthesis, may get here, in which
		 * case, must add proper code to "reduce" it) */
		eparse_error(null, "not a rvalue");
	}
    }
    else if (estring_p(cons)) {
	tag = string_tag;
	eliteral(cons);
	east_link(ecode_simple(eop_pp));
    }
    else
	tag = eobject_address(cons);

    return (etag_pointer(tag));
}

etag_t *
epointer_load(eobject_t list)
{
    etag_t	*tag;

    tag = setup_pointer(ecar(list));
    east_link(ecode_simple(eop_lref));
    return (*(eobject_t *)tag->data);
}

etag_t *
epointer_store(eobject_t list, eobject_t value)
{
    etag_t	*tag;

    (void)setup_pointer(ecar(list));
    east_link(ecode_push());
    tag = eeval(value);
    east_link(ecode_simple(eop_sref));
    return (tag);
}

etag_t *
epointer_setop(eobject_t list, eobject_t value, ecode_t code)
{
    etag_t		*tag;

    tag = setup_pointer(ecar(list));
    east_link(ecode_push());
    east_link(ecode_simple(eop_lref));
    east_link(ecode_push_binarg());
    tag = eeval(value);
    east_logic_link(ecode_binary(code));
    east_link(ecode_simple(eop_sref));
    return (*(eobject_t *)tag->data);
}

etag_t *
epointer_incdec(eobject_t list, ebool_t post, ecode_t code)
{
    etag_t	*tag;

    tag = setup_pointer(ecar(list));
    if (post)
	east_link(ecode_push_incdec_complex());
    east_link(ecode_push());
    east_link(ecode_simple(eop_lref));
    if (post)
	east_link(ecode_stack_store_value(-2));
    east_link(ecode_simple(code));
    east_link(ecode_simple(eop_sref));
    if (post)
	east_link(ecode_stack_pop());
    return (*(eobject_t *)tag->data);
}

etag_t *
evararg_load(eobject_t list)
{
    eint32_t	length;
    eint32_t	offset;

    length = setup_vararg(list);
    list = ecar(list);
    if (enumber_offset(list, &offset))
	east_link(ecode_vararg_static(eop_lvai, length, offset));
    else if (!etag_number_p(eeval(list)))
	eparse_error(null, "not an offset");
    else
	east_link(ecode_vararg(eop_lva, length));
    return (null);
}

etag_t *
evararg_store(eobject_t list, eobject_t value)
{
    etag_t	*tag;
    eint32_t	 offset;
    eint32_t	 length;

    length = setup_vararg(list);
    list = ecar(list);
    if (enumber_offset(list, &offset)) {
	tag = eeval(value);
	east_link(ecode_vararg_static(eop_svai, length, offset));
    }
    else if (!etag_number_p(eeval(list)))
	eparse_error(null, "not an offset");
    else {
	east_link(ecode_push());
	tag = eeval(value);
	east_link(ecode_vararg(eop_sva, length));
    }
    return (tag);
}

etag_t *
evararg_setop(eobject_t list, eobject_t value, ecode_t code)
{
    etag_t		*tag;
    eint32_t		 length;
    eint32_t		 offset;

    length = setup_vararg(list);
    list = ecar(list);
    if (enumber_offset(list, &offset)) {
	east_link(ecode_vararg_static(eop_lvai, length, offset));
	east_link(ecode_push_binarg());
	tag = eeval(value);
	east_logic_link(ecode_binary(code));
	east_link(ecode_vararg_static(eop_svai, length, offset));
    }
    else if (!etag_number_p(eeval(list)))
	eparse_error(null, "not an offset");
    else {
	east_link(ecode_push());
	east_link(ecode_vararg(eop_lva, length));
	east_link(ecode_push_binarg());
	tag = eeval(value);
	east_logic_link(ecode_binary(code));
	east_link(ecode_vararg(eop_sva, length));
    }
    return (tag);
}

etag_t *
evararg_incdec(eobject_t list, ebool_t post, ecode_t code)
{
    eint32_t	length;
    eint32_t	offset;

    length = setup_vararg(list);
    list = ecar(list);
    if (enumber_offset(list, &offset)) {
	east_link(ecode_vararg_static(eop_lvai, length, offset));
	if (post)
	    east_link(ecode_push_incdec());
	east_link(ecode_simple(code));
	east_link(ecode_vararg_static(eop_svai, length, offset));
    }
    else if (!etag_number_p(eeval(list)))
	eparse_error(null, "not an offset");
    else {
	if (post)
	    east_link(ecode_push_incdec_complex());
	east_link(ecode_push());
	east_link(ecode_vararg(eop_lva, length));
	if (post)
	    east_link(ecode_stack_store_value(-2));
	east_link(ecode_simple(code));
	east_link(ecode_vararg(eop_sva, length));
    }
    if (post)
	east_link(ecode_stack_pop());
    return (null);
}

etag_t *
evararg_address(eobject_t list)
{
    eint32_t	length;

    length = setup_vararg(list);
    list = ecar(list);
    /* no opcode for static vararg offset */
    if (!etag_number_p(eeval(list)))
	eparse_error(null, "not an offset");
    east_link(ecode_vararg(eop_pva, length));
    return (pointer_tag);
}

etag_t *
ehash_load(eobject_t list)
{
    setup_hash(list);
    east_link(ecode_hash(eop_lh));
    return (null);
}

etag_t *
ehash_store(eobject_t list, eobject_t value)
{
    etag_t	*tag;

    setup_hash(list);
    east_link(ecode_push());
    tag = eeval(value);
    east_link(ecode_hash(eop_sh));
    return (tag);
}

etag_t *
ehash_setop(eobject_t list, eobject_t value, ecode_t code)
{
    eint32_t		 arg;
    etag_t		*tag;

    setup_hash(list);
    arg = 2;
    east_link(ecode_hash_ref(eop_lhref, arg));
    tag = eeval(value);
    east_logic_link(ecode_binary(code));
    arg = 0;
    east_link(ecode_hash_ref(eop_shref, arg));
    return (tag);
}
 
etag_t *
ehash_incdec(eobject_t list, ebool_t post, ecode_t code)
{
    eint32_t	arg;

    setup_hash(list);
    arg = post ? 1 : 0;
    east_link(ecode_hash_ref(eop_lhref, arg));
    east_link(ecode_simple(code));
    east_link(ecode_hash_ref(eop_shref, arg));
    return (null);
}

etag_t *
eobject_load(eobject_t list)
{
    etag_t	*tag;
    eobject_t	 cons;

    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_load(list);
	    break;
	case t_cons:
	    cons = ecar(list);
	    if (!efixnum_p(cons))
		eparse_error(null, "expecting expression");
	    list = ecdr(list);
	    switch (eget_fixnum(cons)) {
		case tok_type:
		    tag = ecadr(list);
		    eobject_load(ecar(list));
		    break;
		case tok_vector:
		    tag = evector_load(list);
		    break;
		case tok_field:
		    tag = estruct_load(list);
		    break;
		case tok_pointer:
		    tag = epointer_load(list);
		    break;
		default:
		    eparse_error(null, "not a rvalue");
	    }
	    break;
	default:
	    eparse_error(null, "not a rvalue");
    }

    return (tag);
}

etag_t *
eobject_store(eobject_t list, eobject_t value)
{
    etag_t	*tag;
    eobject_t	 cons;

    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_store(list, value);
	    break;
	case t_cons:
	    cons = ecar(list);
	    if (!efixnum_p(cons))
		eparse_error(null, "expecting expression");
	    list = ecdr(list);
	    switch (eget_fixnum(cons)) {
		case tok_type:
		    tag = ecadr(list);
		    eobject_store(ecar(list), value);
		    break;
		case tok_vector:
		    tag = evector_store(list, value);
		    break;
		case tok_field:
		    tag = estruct_store(list, value);
		    break;
		case tok_pointer:
		    tag = epointer_store(list, value);
		    break;
		default:
		    eparse_error(null, "not a lvalue");
	    }
	    break;
	default:
	    eparse_error(null, "not a lvalue");
    }

    return (tag);
}

etag_t *
eobject_setop(eobject_t list, eobject_t value, ecode_t code)
{
    etag_t	*tag;
    eobject_t	 cons;

    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_setop(list, value, code);
	    break;
	case t_cons:
	    cons = ecar(list);
	    if (!efixnum_p(cons))
		eparse_error(null, "expecting expression");
	    list = ecdr(list);
	    switch (eget_fixnum(cons)) {
		case tok_type:
		    tag = ecadr(list);
		    eobject_setop(ecar(list), value, code);
		    break;
		case tok_vector:
		    tag = evector_setop(list, value, code);
		    break;
		case tok_field:
		    tag = estruct_setop(list, value, code);
		    break;
		case tok_pointer:
		    tag = epointer_setop(list, value, code);
		    break;
		default:
		    eparse_error(null, "not a lvalue");
	    }
	    break;
	default:
	    eparse_error(null, "not a lvalue");
    }
    return (tag);
}

etag_t *
eobject_incdec(eobject_t list, ebool_t post, ecode_t code)
{
    etag_t	*tag;
    eobject_t	 cons;

    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_incdec(list, post, code);
	    break;
	case t_cons:
	    cons = ecar(list);
	    if (!efixnum_p(cons))
		eparse_error(null, "expecting expression");
	    list = ecdr(list);
	    switch (eget_fixnum(cons)) {
		case tok_type:
		    tag = ecadr(list);
		    eobject_incdec(ecar(list), post, code);
		    break;
		case tok_vector:
		    tag = evector_incdec(list, post, code);
		    break;
		case tok_field:
		    tag = estruct_incdec(list, post, code);
		    break;
		case tok_pointer:
		    tag = epointer_incdec(list, post, code);
		    break;
		default:
		    eparse_error(null, "not a lvalue");
	    }
	    break;
	default:
	    eparse_error(null, "not a lvalue");
    }
    return (tag);
}

etag_t *
eobject_address(eobject_t list)
{
    etag_t	*tag;
    eobject_t	 cons;

    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_address(list);
	    break;
	case t_cons:
	    cons = ecar(list);
	    if (!efixnum_p(cons))
		eparse_error(null, "expecting expression");
	    list = ecdr(list);
	    switch (eget_fixnum(cons)) {
		case tok_type:
		    tag = ecadr(list);
		    eobject_address(ecar(list));
		    break;
		case tok_vector:
		    tag = evector_address(list);
		    break;
		case tok_field:
		    tag = estruct_address(list);
		    break;
		default:
		    eparse_error(null, "not a rvalue");
	    }
	    break;
	default:
	    eparse_error(null, "not a rvalue");
    }

    return (tag);
}

static esymbol_t *
setup_symbol(esymbol_t *name, char *kind)
{
    esymbol_t	*atom;

    atom = eget_bound_symbol(name);
    if (atom->a_function || atom->a_builtin)
	/* FIXME 'f = fname;' and 'f = &fname;' should be equivalent
	 * as in "C", but generate an error for consistency, in the
	 * sense that only "function pointers" can make any use of a
	 * "function reference", and the syntax is to use the operator
	 * '*' to call a function pointer object. So, it is just natural
	 * to initialize a pointer object by taking an address.
	 */
	eparse_error(null, "'%p' is not a %s", atom->name, kind);
    /* FIXME for now it is ok to give precedence to globals when
     * there is a name clash, as there isn't an ::<name> construct,
     * but there is a this.<name> */
    if (atom->a_global) {
	/* if symbol only declared so far */
	if (atom->offset < 0)
	    eglobal_variable(atom->tag, atom);
    }
    else if (atom->a_method)
	eparse_error(null, "'%p' is not a %s", atom->name, kind);

    return (atom);
}

static eint32_t
setup_single_vector(eobject_t list, eobject_t length)
{
    eint32_t	offset;
    eobject_t	object;

    if (list == null || ecdr(list))
	eparse_error(null, "expecting offset");
    object = ecar(list);
    if (enumber_offset(object, &offset)) {
	if (eget_fixnum(length) && offset >= eget_fixnum(length))
	    eparse_warn(null, "possible offset out of bounds");
    }
    else {
	/* push vector */
	east_link(ecode_push());
	if (!etag_number_p(eeval(object)))
	    /* invalid parameter known at parse time */
	    eparse_error(null, "not an offset");
	/* flag as a dynamic offset */
	offset = -1;
    }
    return (offset);
}

static eint32_t
setup_vector(eobject_t list, eobject_t *values, eint32_t length)
{
    eint32_t	rank;
    eint32_t	index;
    eint32_t	offset;
    eobject_t	object;

    /* push vector */
    east_link(ecode_push());
    for (rank = index = 0;
	 list && index < length;
	 index++, list = ecdr(list), rank++) {
	object = ecar(list);
	/* if need to dereference a pointer vector */
	if (eget_fixnum(values[index]) == 0) {
	    if (index) {
		/* load intermediate vector data */
		east_link(ecode_vector_load(rank));
		east_link(ecode_push());
	    }
	    /* restart */
	    rank = 0;
	}
	/* else keep calculating offset */
	else {
	    /* push last evaluated offset */
	    if (rank)
		east_link(ecode_vector_offset(rank));
	    if (enumber_offset(object, &offset) &&
		offset >= eget_fixnum(values[index]))
		eparse_warn(null, "possible offset out of bounds");
	}
	if (!etag_number_p(eeval(object)))
	    eparse_error(null, "not an offset");
    }
    /* error checking */
    if (list)
	eparse_error(null, "too many offsets");
    else if (index < length && values[index] != efixnum(0))
	eparse_error(null, "too few offsets");

    return (rank);
}

static void
setup_struct(eobject_t list, erecord_t **record_r, esymbol_t **symbol_r)
{
    etag_t	*tag;
    esymbol_t	*name;
    erecord_t	*record;
    esymbol_t	*symbol;

    /* find record tag */
    tag = eeval(ecar(list));
    if (tag == null || (tag->type != tag_struct && tag->type != tag_class))
	eparse_error(null, "not a record");
    record = tag->data;
    /* find record field */
    name = ecadr(list);
    if (!esymbol_p(name))
	eparse_error(null, "expecting field name");
    if ((symbol = eget_field(record, name->name)) == null)
	eparse_error(null, "struct '%p' has no field '%p'",
		     record->name->name, name->name);
    *record_r = record;
    *symbol_r = symbol;
}

static esymbol_t *
class_field(esymbol_t *name)
{
    esymbol_t	*atom;
    erecord_t	*record;

    if ((record = fn_current->record) == null)
	eparse_error(null, "'this' must be used in class methods");
    if ((atom = eget_field(record, name->name)) == null)
	eparse_error(null, "class '%p' has no field '%p'",
		     record->name->name, name->name);

    return (atom);
}

static etag_t *
setup_pointer(eobject_t pointer)
{
    etag_t	*tag;

    tag = eobject_load(pointer);
    if (tag == null || tag->type != tag_pointer)
	eparse_error(null, "not a pointer object");

    return (tag);
}

static eint32_t
setup_vararg(eobject_t list)
{
    if (fn_current == fn_root || !fn_current->voffset)
	eparse_error(null, "function is not vararg");
    if (list == null || ecdr(list))
	eparse_error(null, "expecting offset");
    return (fn_current->voffset);
}

static void
setup_hash(eobject_t list)
{
    if (list == null || ecdr(list))
	eparse_error(null, "expecting name");
    east_link(ecode_push());
    (void)eeval(ecar(list));
}

static void
initialize(eobject_t pointer, eobject_t object,
	   eint32_t offset, etype_t r_type, etype_t f_type,
	   erecord_t *record, esymbol_t *symbol)
{
    etype_t		 o_type;
    eint32_t		 length;
    union {
	eobject_t	*v;
	eint8_t		*i8;
	eint16_t	*i16;
	eint32_t	*i32;
	eint64_t	*i64;
	efloat32_t	*f32;
	efloat64_t	*f64;
    } v;

    v.v = pointer;
    o_type = etype(object) & ~t_const;
    if (evector_type_p(r_type)) {
	switch (f_type) {
	    case t_int8:  	case t_uint8:
		v.i8 += offset;
		break;
	    case t_int16: 	case t_uint16:
		v.i16 += offset;
		break;
	    case t_float32:	case t_int32:		case t_uint32:
		v.i32 += offset;
		break;
	    case t_float64:	case t_int64:		case t_uint64:
		v.i64 += offset;
		break;
	    default:
		v.v += offset;
		break;
	}
    }
    else
	v.i8 += offset;

    switch (o_type) {
	case t_fixnum:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = eget_fixnum(object);
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = eget_fixnum(object);
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = eget_fixnum(object);
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = eget_fixnum(object);
		    break;
		case t_float32:
		    *v.f32 = eget_fixnum(object);
		    break;
		case t_float64:
		    *v.f64 = eget_fixnum(object);
		    break;
		case t_void:
		    enew_integer(v.v, eget_fixnum(object));
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_int:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = *(eint_t *)object;
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = *(eint_t *)object;
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = *(eint_t *)object;
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = *(eint_t *)object;
		    break;
		case t_float32:
		    *v.f32 = *(eint_t *)object;
		    break;
		case t_float64:
		    *v.f64 = *(eint_t *)object;
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_float64:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = (eword_t)*(efloat_t *)object;
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = (eword_t)*(efloat_t *)object;
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = (eword_t)*(efloat_t *)object;
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = (eint_t)*(efloat_t *)object;
		    break;
		case t_float32:
		    *v.f32 = *(efloat_t *)object;
		    break;
		case t_float64:
		    *v.f64 = *(efloat_t *)object;
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_mpz:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = empz_get_i((empz_t)object);
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = empz_get_i((empz_t)object);
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = empz_get_i((empz_t)object);
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = empz_get_i((empz_t)object);
		    break;
		case t_float32:
		    *v.f32 = empz_get_d((empz_t)object);
		    break;
		case t_float64:
		    *v.f64 = empz_get_d((empz_t)object);
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_mpq:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = empq_get_i((empq_t)object);
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = empq_get_i((empq_t)object);
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = empq_get_i((empq_t)object);
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = empq_get_i((empq_t)object);
		    break;
		case t_float32:
		    *v.f32 = empq_get_d((empq_t)object);
		    break;
		case t_float64:
		    *v.f64 = empq_get_d((empq_t)object);
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_mpr:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = empr_get_i((empr_t)object);
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = empr_get_i((empr_t)object);
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = empr_get_i((empr_t)object);
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = empr_get_i((empr_t)object);
		    break;
		case t_float32:
		    *v.f32 = empr_get_d((empr_t)object);
		    break;
		case t_float64:
		    *v.f64 = empr_get_d((empr_t)object);
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_cdd:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = ecdd_get_i(*(ecdd_t *)object);
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = ecdd_get_i(*(ecdd_t *)object);
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = ecdd_get_i(*(ecdd_t *)object);
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = ecdd_get_i(*(ecdd_t *)object);
		    break;
		case t_float32:
		    *v.f32 = ecdd_get_d(*(ecdd_t *)object);
		    break;
		case t_float64:
		    *v.f64 = ecdd_get_d(*(ecdd_t *)object);
		    break;
		case t_void:
		    *v.v  = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_cqq:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = ecqq_get_i((ecqq_t)object);
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = ecqq_get_i((ecqq_t)object);
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = ecqq_get_i((ecqq_t)object);
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = ecqq_get_i((ecqq_t)object);
		    break;
		case t_float32:
		    *v.f32 = ecqq_get_d((ecqq_t)object);
		    break;
		case t_float64:
		    *v.f64 = ecqq_get_d((ecqq_t)object);
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_mpc:
	    switch (f_type) {
		case t_int8:	case t_uint8:
		    *v.i8 = empc_get_i((empc_t)object);
		    break;
		case t_int16:	case t_uint16:
		    *v.i16 = empc_get_i((empc_t)object);
		    break;
		case t_int32:	case t_uint32:
		    *v.i32 = empc_get_i((empc_t)object);
		    break;
		case t_int64:	case t_uint64:
		    *v.i64 = empc_get_i((empc_t)object);
		    break;
		case t_float32:
		    *v.f32 = empc_get_d((empc_t)object);
		    break;
		case t_float64:
		    *v.f64 = empc_get_d((empc_t)object);
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_string:
	    switch (f_type) {
		case t_uint8:
		    object = ((evector_t *)object)->v.obj;
		    length = eobject_length(object);
		    if (length > eobject_length(pointer) - offset)
			eparse_error(null, "too many initializers");
		    memcpy(v.i8, object, length);
		    break;
		case t_void:
		    *v.v = object;
		    break;
		default:
		    eparse_error(null, "type coercion error");
	    }
	    break;
	case t_void:
	    break;
	case t_symbol:
	case t_cons:
	    /* push current value */
	    east_link(ecode_push());

	    /* FIXME check that the returned type tag is compatible */
	    eeval(object);

	    if (evector_type_p(r_type))
		east_link(ecode_vector_store_static(offset));
	    else
		east_link(ecode_record_store(record, symbol));

	    /* load current value */
	    east_link(ecode_stack_load(-1));
	    break;
	default:
	    if (f_type == t_void || o_type == f_type) {
		if (fn_current != fn_root) {
		    if (evector_type_p(r_type))
			east_link(ecode_vector_store_static(offset));
		    else
			east_link(ecode_record_store(record, symbol));
		    /* load and push current value */
		    east_link(ecode_stack_load(-1));
		    east_link(ecode_push());
		}
		else
		    *v.v = object;
	    }
	    else
		eparse_error(null, "type coercion error");
    }
}

static void
vector_allocate(eobject_t pointer, eobject_t list,
		eobject_t *values, eint32_t dimensions,
		eint32_t offset, etype_t type, eint32_t length)
{
    eint32_t	 rank;
    etype_t	 v_type;
    evector_t	*vector;

    for (rank = 1; rank < dimensions; rank++)
	if (eget_fixnum(values[rank]) == 0)
	    break;
    v_type = t_vector;
    /* if not an intermediate pointer vector */
    if (rank == dimensions) {
	if (type == t_uint8 && length == 1 && econs_p(list) &&
	    (etype(ecar(list)) & ~t_const) == t_string)
	    length = eobject_length(((evector_t *)ecar(list))->v.obj);
	v_type |= type;
    }
    evector(&vector, v_type & ~t_vector, length, rank);
    if (rank > 1) {
	eint32_t	i;

	for (i = 0; i < rank; i++) {
	    vector->dims[i].dim = eget_fixnum(values[i]);
	    vector->dims[i].mul = 1;
	}
	for (i = rank - 1; i > 0; i--)
	    vector->dims[i - 1].mul = vector->dims[i].dim * vector->dims[i].mul;
    }
    ((eobject_t *)pointer)[offset] = vector;

    /* push parent */
    east_link(ecode_push());

    if (fn_current != fn_root) {
	/* make runtime copy */

	/* push parent */
	east_link(ecode_push());

	/* create copy */
	east_link(ecode_vector_new_static(v_type, length, rank, values));
	east_link(ecode_push());

	/* copy initialize */
	eliteral(vector);
	east_link(ecode_vector_copy(length));

	/* store in parent */
	east_link(ecode_vector_store_static(offset));
    }
    else
	/* load the vector */
	east_link(ecode_vector_load_static(offset));

    vector_initialize(vector->v.obj, list, values, dimensions, 0, type);

    /* load parent */
    east_link(ecode_stack_pop());
}

static void
vector_initialize(eobject_t pointer, eobject_t list,
		  eobject_t *values, eint32_t dimensions,
		  eint32_t offset, etype_t type)
{
    eint32_t	i;
    eint32_t	length;
    eobject_t	object;
    eint32_t	dimension;

    if (fn_current != fn_root)
	east_link(ecode_push());
    if (dimensions == 1) {
	if (estring_p(list))
	    initialize(pointer, list, offset, type | t_vector, type,
		       null, null);
	else
	    for (; list; list = ecdr(list), offset++)
		initialize(pointer, ecar(list), offset, type | t_vector, type,
			   null, null);
	goto done;
    }

    for (; list; list = ecdr(list)) {
	object = ecar(list);
	if (econs_p(object)) {
	    /* check for, and remove the initial tok_data */
	    if (!efixnum_p(ecar(object)) ||
		eget_fixnum(ecar(object)) != tok_data)
		eparse_error(null, "expecting initializer");
	    object = ecdr(object);
	    erplaca(list, object);

	string_vector:
	    dimension = eget_fixnum(values[1]);

	    /* if there are any initializers */
	    if ((length = vector_format(object))) {
		/* if a nested pointer vector */
		if (dimension == 0) {
		    vector_allocate(pointer, object, values + 1,
				    dimensions - 1, offset,
				    type, length);
		    offset++;
		}
		else if (length <= dimension) {
		    vector_initialize(pointer, object, values + 1,
				      dimensions - 1, offset, type);
		    /* next initial offset in linear vector */
		    for (i = length = 1; i < dimensions; i++) {
			if ((dimension = eget_fixnum(values[i])))
			    length *= dimension;
			else
			    break;
		    }
		    offset += length;
		}
		else
		    eparse_error(null, "too many initializers");
	    }
	}
	else if (estring_p(object))
	    goto string_vector;
	else if (esymbol_p(object))
	    /* FIXME check symbol type tag */
	    initialize(pointer, object, offset++, type | t_vector, type,
		       null, null);
	else
	    eparse_error(null, "expecting initializer");
    }
done:
    if (fn_current != fn_root)
	east_link(ecode_stack_pop());
}

static void
struct_initialize(eint8_t *object, eobject_t list, erecord_t *record)
{
    eint32_t	  i;
    etag_t	 *save;
    eobject_t	  init;
    eint32_t	  count;
    erecord_t	 *field;
    etype_t	  f_type;
    etype_t	  r_type;
    eint32_t	  offset;
    esymbol_t	**fields;
    esymbol_t	 *symbol;

    save = data_tag;
    if (record->vfield) {
	fields = record->vfield->v.obj;
	count = record->fields->count;
    }
    else {
	fields = null;
	count = 0;
    }
    r_type = record->type & ~t_pointer;
    if (fn_current != fn_root)
	east_link(ecode_push());
    for (i = 0; i < count && list; i++, list = ecdr(list)) {
	symbol = fields[i];
	offset = symbol->offset;
	if ((data_tag = symbol->tag) &&
	    data_tag->type >= tag_basic && data_tag->type <= tag_class) {
	    field = data_tag->data;
	    f_type = field->type;
	}
	else
	    f_type = t_void;
	init = ecar(list);
	if (econs_p(init) && ecar(init) == efixnum(tok_data))
	    init = data_object(ecdr(init));
	initialize(object, init, offset, r_type, f_type,
		   record, symbol);
    }
    if (fn_current != fn_root)
	east_link(ecode_stack_pop());
    if (list)
	eparse_error(null, "too many initializers");
    data_tag = save;
}

static eobject_t
data_vector(eobject_t list)
{
    etag_t	*base;
    etag_t	*save;
    eint32_t	 rank;
    eint32_t	 size;
    etype_t	 type;
    etype_t	 v_type;
    eint32_t	 length;
    eobject_t	*values;
    erecord_t	*record;
    evector_t	*vector;
    eint32_t	 dimensions;

    save = data_tag;
    values = data_tag->data;
    data_tag = base = values[0];

    /* check base data type for array/vector */
    type = t_void;
    record = null;
    if (base && base->type == tag_basic) {
	record = base->data;
	type = record->type;
    }

    dimensions = (eobject_length(values) / sizeof(eobject_t)) - 1;
    ++values;

    /* check first/only array/vector dimension */
    size = vector_format(list);
    if ((rank = eget_fixnum(values[0]))) {
	if (size > rank)
	    eparse_error(null, "too many initializers");
	else if (rank > size)
	    size = rank;
   }

    /* number of entries in toplevel or entire array/vector */
    for (rank = 1; rank < dimensions; rank++) {
	if ((length = eget_fixnum(values[rank])))
	    size *= length;
	else
	    break;
    }
    v_type = t_vector;
    if (rank == dimensions)
	v_type |= type;

    /* create main vector */
    v_check(1);
    evector(&vector, v_type & ~t_vector, size, rank);
    if (rank > 1) {
	eint32_t	i;

	for (i = 0; i < rank; i++) {
	    vector->dims[i].dim = eget_fixnum(values[i]);
	    vector->dims[i].mul = 1;
	}
	for (i = rank - 1; i > 0; i--)
	    vector->dims[i - 1].mul = vector->dims[i].dim * vector->dims[i].mul;
    }
    v_push(vector);

    /* if a vector local to a function */
    if (fn_current != fn_root) {
	east_link(ecode_vector_new_static(v_type, size, rank, values));
	east_link(ecode_push());
    }

    /* load vector */
    eliteral(vector);
    v_dec();

    /* load a constant copy of the vector just created */
    if (fn_current != fn_root)
	east_link(ecode_vector_copy(size));

    /* make vector the current value */
    east_link(ecode_push());

    /* initialize vector contents */
    vector_initialize(vector->v.obj, list, values, dimensions, 0, type);
    data_tag = save;

    /* restore stack and keep vector the current value */
    east_link(ecode_stack_pop());

    return (vector);
}

static eobject_t
data_record(eobject_t list)
{
    eint8_t	 *object;
    erecord_t	 *record;

    record = data_tag->data;

    /* create record */
    v_check(1);
    enew_object((eobject_t *)&object, record->type, record->size);
    v_push(object);

    /* if a local record */
    if (fn_current != fn_root) {
	east_link(ecode_record_new(record));
	east_link(ecode_push());
    }

    /* load record */
    eliteral(object);
    v_dec();

    /* copy initializer */
    if (fn_current != fn_root)
	east_link(ecode_record_copy(record));

    /* make record the current value */
    east_link(ecode_push());

    struct_format(record, list);
    struct_initialize(object, list, record);

    if (data_tag->type == tag_class &&
	eget_symbol(record->methods, symbol_new->name) != null) {
	east_link(ecode_stack_load(-1));
	eapply_method(true, data_tag, symbol_new, null);
    }

    /* restore stack and keep record the current value */
    east_link(ecode_stack_pop());

    return (object);
}

static eobject_t
data_union(eobject_t list)
{
    etag_t	*save;
    eobject_t	 object;
    erecord_t	*record;
    esymbol_t	*symbol;

    record = data_tag->data;

    if (elength(list) > 1)
	eparse_error(null, "too many initializers");

    if (list) {
	object = ecar(list);
	if (econs_p(object) && ecar(object) == efixnum(tok_offset)) {
	    object = ecdr(object);
	    erplaca(list, ecadr(object));
	    symbol = ecar(object);
	    if (!esymbol_p(symbol))
		eparse_error(null, "expecting symbol");
	    if ((object = eget_field(record, symbol->name)) == null)
		eparse_error(null, "union '%p' has no field '%p'",
			     record->name->name, symbol->name);
	    symbol = object;
	    save = data_tag;
	    data_tag = symbol->tag;
	    object = ecar(list);
	    if (econs_p(object)) {
		if (ecar(object) == efixnum(tok_data))
		    object = ecdr(object);
	    }
	    object = data_object(object);
	    data_tag = save;
	}
    }
    else
	object = null;

    return (object);
}

static eobject_t
data_object(eobject_t list)
{
    eobject_t	 object;

    if (data_tag == null)
	object = list;
    else {
	switch (data_tag->type) {
	    case tag_vector:
		object = data_vector(list);
		break;
	    case tag_basic:
		object = list;
		break;
	    case tag_class:
	    case tag_struct:
		object = data_record(list);
		break;
	    case tag_union:
		object = data_union(list);
		break;
	    default:
		eparse_error(null, "syntax error");
	}
    }

    return (object);
}

static eint32_t
vector_format(eobject_t list)
{
    eobject_t	 base;
    eobject_t	 prev;
    eobject_t	 object;
    eint32_t	 before;
    eint32_t	 length;
    eint32_t	 offset;
    evector_t	*vector;

    if (estring_p(list)) {
	vector = list;

	return (vector->length);
    }

    offset = length = 0;
    for (base = prev = list; list; prev = list, list = ecdr(list)) {
	object = ecar(list);
	if (econs_p(object) && ecar(object) == efixnum(tok_offset)) {
	    object = ecdr(object);
	    erplaca(list, ecadr(object));
	    object = ecar(object);
	    if (!efixnum_p(object))
		eparse_error(null, "expecting integer");
	    before = offset;
	    offset = eget_fixnum(object);
	    if (offset < 0 || offset > most_positive_fix32)
		eparse_error(null, "offset out of bounds");
	    if (offset != before)
		object_format(offset, before, base, &list, &prev);
	}
	/* next starting offset */
	if (++offset > length)
	    length = offset;
    }

    return (length);
}

static void
struct_format(erecord_t *record, eobject_t list)
{
    eobject_t	  base;
    eobject_t	  prev;
    esymbol_t	 *symbol;
    esymbol_t	**fields;
    eint32_t	  before;
    eint32_t	  length;
    eint32_t	  offset;

    offset = 0;
    if (record->vfield) {
	fields = record->vfield->v.obj;
	length = record->fields->count;
    }
    else {
	fields = null;
	length = 0;
    }
    for (base = prev = list; list; prev = list, list = ecdr(list)) {
	symbol = ecar(list);
	if (econs_p(symbol) && ecar(symbol) == efixnum(tok_offset)) {
	    symbol = ecdr(symbol);
	    erplaca(list, ecadr(symbol));
	    symbol = ecar(symbol);
	    if (!esymbol_p(symbol))
		eparse_error(null, "expecting symbol");
	    before = offset;
	    for (offset = 0; offset < length; offset++) {
		if (fields[offset]->name->v.obj == symbol->name->v.obj)
		    break;
	    }
	    if (offset >= length)
		eparse_error(null, "struct '%p' has no field '%p'",
			     record->name->name, symbol->name);
	    if (offset != before)
		object_format(offset, before, base, &list, &prev);
	}
	/* next starting offset */
	if (++offset > length)
	    eparse_error(null, "too many initializers");
    }
}

static void
object_format(eint32_t offset, eint32_t before, eobject_t base,
	      eobject_t *list_r, eobject_t *prev_r)
{
    eobject_t	cons;
    eobject_t	copy;
    eobject_t	list;
    eobject_t	prev;
    eobject_t	next;

    prev = *prev_r;
    list = *list_r;
    if (offset < before) {
	cons = prev;
	if (offset == 0) {
	    erplaca(base, ecadr(prev));
	    erplacd(prev, ecddr(prev));
	    list = prev = base;
	}
	else {
	    for (before = 1, list = base; before < offset; before++)
		list = ecdr(list);
	    erplaca(ecdr(list), ecadr(prev));
	    erplacd(prev, ecddr(prev));
	    prev = list;
	    list = ecdr(list);
	}
	copy = ecdr(list);
	while ((next = ecdr(cons)) && (!econs_p(ecar(next)) ||
				       ecaar(next) != efixnum(tok_offset))) {
	    erplaca(copy, ecar(next));
	    erplacd(cons, ecdr(next));
	    copy = ecdr(copy);
	}
    }
    else if (offset > before) {
	do {
	    erplacd(list, econs(ecar(list), ecdr(list)));
	    erplaca(list, null);
	    prev = list;
	    list = ecdr(list);
	} while (++before < offset);
    }
    *list_r = list;
    *prev_r = prev;
}
